Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/tb3to5.zip/TB3TO5.PAS

Pascal/Delphi Source File | 1993-01-04 | 5KB | 174 lines

program TB3TO5;

{Program to convert Turbo 3 toolbox data files to Turbo 4/5 data files.
 This is accomplished by changing the status word (beginning of each
 record) from a two Byte integer to a four Byte longint.  Only active
 records are copied.  Deleted records are compressed out of the output
 file.  This program will only copy data records.  It will be necessary
 to reconstruct the index of the file with a program written in, or con-
 verted to Turbo 4/5.

 Three parameters must be supplied to the program:

   The first parameter is the path and name of the Turbo 3 input file.

   The Second is the path and name of the new Turbo 4/5 output file.

   The Third parameter is the record length of the Turbo 3 data records.

 Restrictions: data records must be less than 4000 Bytes in length!
               This may be changed by modifying the array size of InBuffer.

   }

uses crt;

type HeaderRec = record    { Turbo 4/5 header record }
       FirstFree: longint;
       NumberFree: longint;
       Int1: longint;
       RecLen: word
       end;

var InBuffer: array [1..4002] of Byte;  {Input Buffer}
    ErrorCode: integer;
    InFile,OutFile : file;
    Header: HeaderRec;
    RecNum: longint;
    RecSize: word;
    OutCount : longint;
    lastj : integer;

{PercentLine provides a horizontal bar graph on the screen.  The first
parameter is the vertical position and is specified in the range 0 to 23.
The percentage is calculated from the second and third parameters; in which
the second (dividend) is divided by the third (divisor) to calculate the
percentage.}

procedure PercentLine(y,dvd,dvr:longint);
var
   work : string[20];
   i,j : integer;
   per,rdvd,rdvr,jr : real;
   SaveAttr : Byte;

begin
   SaveAttr:=TextAttr;
   if y > 23 then y:=23;
   if y < 0 then y:=0;
   if (dvd = 0) and (dvr = 0) then
   begin
      GotoXY(1,Y+1);
      TextAttr:=$70;
      Write(' 0.....10.....20.....30.....40.....50.....60.....70.....80.....90....100% ');
      GotoXY(1,Y+2);
      Write('                                                                          ');
      lastj:=0;
      TextAttr:=SaveAttr;
   end else
   begin
      if dvr = 0 then exit;
      Rdvd:=dvd * 1.0;
      Rdvr:=dvr * 1.0;
      per:=Rdvd / Rdvr;
      if per <= 1.0 then
      begin
         jr:=70.0 * per;
         j:=round(jr);
         TextAttr:=$07;
         str((per*100.0):3:0,work);
         GotoXY(76,Y+2);
         Write(work,'%');
         if j >= lastj then
         begin
            for i:=lastj to j+1 do
            begin
               if i > 0 then
               begin
                  GotoXY(I+1,Y+2);
                  Write('▄');
               end;
            end;
         end;
         lastj:=j+1;
      end;
   end;
   TextAttr:=SaveAttr;
end;

{ Start of main line program }

begin
   clrscr;
    case paramcount of
    0: begin
          Writeln('Usage: TB3TO5 from_filename to_filename recsize');
          halt;
       end;
    1,2 : begin
             Writeln('Not enough parameters.');
             halt;
          end;
    3: begin end;
    else begin
            Writeln('Too many parameters.');
            halt;
         end;
    end;
    val(paramstr(3),RecSize,ErrorCode);
     if (ErrorCode<>0) or (RecSize<14) then
    begin
       Writeln('Record size out of range.'^G);
       halt;
    end;
    assign(InFile,paramstr(1));
    {$I-}
    reset(InFile,RecSize);            { Open the input data file }
    {$I+}
    if ioresult <> 0 then
    begin
       Writeln('Could not open input file ''',paramstr(1),'''',^G);
       halt;
    end;
    assign(OutFile,paramstr(2));
    {$I-}
    reWrite(OutFile,RecSize+2);       { Open the output data file }
    {$I+}
    if ioresult <> 0 then
    begin
       Writeln('Could not create output file ''',paramstr(1),'''',^G);
       halt;
    end;
    Writeln('Original record size of ',paramstr(1),' is ',recsize,'.');
    Writeln('New size of ',paramstr(2),' is ',recsize+2,'.');
    Writeln;Writeln;delay(2000);
    clrscr;
    PercentLine(2,0,0);
    OutCount:=0;
    blockread(InFile,InBuffer[3],1);    { Get the header }
    with Header do
    begin
       FirstFree := -1;            { Set deleted record chain }
       NumberFree := 0;            { Number of free records to zero }
       Int1 := 0;                  { Clear index root page }
       RecLen := RecSize + 2;      { Set new record length }
    end;
    blockWrite(OutFile,Header,1);
    for RecNum := 1 to filesize(InFile)-1 do
    begin
       PercentLine(2,RecNum,filesize(InFile)-1);
       seek(InFile,RecNum);
       Inbuffer[1]:=0;
       blockread(InFile,InBuffer[3],1);  { Get a data record }
       if (InBuffer[3] = 0) and (inbuffer[4] = 0) then { Check if deleted }
       begin
          InBuffer[1]:= 0;inbuffer[2]:=0;
          blockWrite(OutFile,InBuffer[1],1); { Write extended new record }
          inc(OutCount);
       end
    end;
    Writeln;Writeln;Writeln;
    Writeln(filesize(InFile)-1,' records read, ',outcount,' records written.');
    close(InFile);close(OutFile);
end.